home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / (A)TA / (A)TAP.ADF / CLICALC / calc.mod < prev   
Text File  |  1987-02-03  |  7KB  |  318 lines
  1. (*$S- don't check the stack *)
  2. (*$T- turn off range checking *)
  3.  
  4. (* Developed using Modula-2/Amiga *)
  5. (* TDI Software Inc. Dallas, Texas *)
  6.  
  7. (* Author: Robert Jones *)
  8. (* Development Date: February 29, 1988 *)
  9. (* Last Updated: April 24, 1988 *)
  10.  
  11. (* This program and its source code may be freely distributed in the *)
  12. (* public domain. *)
  13.  
  14. (* To understand this program you should have an understanding of basic *)
  15. (* arithmatical syntax.  This program breaks down the input into its *)
  16. (* component simple expression, term, and factor parts. *)
  17.  
  18. MODULE calc;
  19.  
  20. FROM Conversions IMPORT ConvertRealFromString;
  21. FROM M2Conversions IMPORT ConvertReal;
  22. FROM CommandLine IMPORT CLStrings, GetCL;
  23. FROM Terminal IMPORT WriteString, WriteLn;
  24. FROM MathLib0 IMPORT sin, cos, tan, arctan, exp, ln, log, sqrt, e, pi,
  25.                      RadToDeg, DegToRad;
  26. FROM Strings IMPORT Assign, Concat;
  27.  
  28. TYPE
  29.    StringType = ARRAY [0..79] OF CHAR;
  30.    ArgArrayType = ARRAY [0..15] OF CLStrings;
  31.    chset = SET OF CHAR;
  32.  
  33. CONST alphabet = chset {"A".."Z", "a".."z"};  (* not standard MODULA 2 *)
  34.  
  35. VAR
  36.    i, j, num: CARDINAL;
  37.    ArgArray: ArgArrayType;
  38.    result: REAL;
  39.    NoError: BOOLEAN;
  40.    StringAns, Equation, dummy: StringType;
  41.  
  42. (* =========================== StrCmp ============================= *)
  43.  
  44. PROCEDURE StrCmp (VAR s1: ARRAY OF CHAR; VAR s2: ARRAY OF CHAR): BOOLEAN;
  45.  
  46. (* StrCmp compares null terminated strings for equality. *)
  47.  
  48. VAR
  49.    i, j: CARDINAL;
  50.  
  51. BEGIN
  52.    j := 0;
  53.    i := 0;
  54.  
  55.    WHILE (s1 [i] = s2 [i]) & ((s1 [i] # 0C) & (s2 [i] # 0C)) DO
  56.       INC (i);
  57.       INC (j);
  58.    END;
  59.  
  60.    IF (s1 [i] # 0C) & (s2 [i] # 0C) THEN
  61.       RETURN FALSE
  62.    ELSE
  63.       RETURN TRUE;
  64.    END;
  65. END StrCmp;
  66.  
  67. (* =========================== IsFunc =========================== *)
  68.  
  69. PROCEDURE IsFunc (VAR s: ARRAY OF CHAR; VAR FuncString: ARRAY OF CHAR; 
  70.                   VAR i: CARDINAL): BOOLEAN;
  71.  
  72. VAR
  73.    j, temp: CARDINAL;
  74.  
  75. BEGIN
  76.    j := 0;
  77.    temp := i;
  78.    FuncString [0] := 0C;
  79.  
  80.    WHILE s [i] IN alphabet DO
  81.       FuncString [j] := s [i];
  82.       INC (j);
  83.       INC (i);
  84.    END;
  85.  
  86.    IF ((s [i] <> "(") & NOT (s [i-1] IN alphabet)) OR
  87.       ((StrCmp ("e", FuncString)) OR (StrCmp ("pi", FuncString))) THEN
  88.       i := temp;
  89.       RETURN FALSE
  90.    ELSE
  91.       FuncString [j] := 0C;
  92.       RETURN TRUE;
  93.    END;
  94. END IsFunc;
  95.  
  96. (* ============================ EvalReal =========================== *)
  97.  
  98. PROCEDURE EvalReal (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
  99.                     VAR ok: BOOLEAN);
  100.  
  101. VAR
  102.    RealString: StringType;
  103.    ch: CHAR;
  104.    j: CARDINAL;
  105.  
  106. BEGIN
  107.    j := 0;
  108.    ch := s [i];
  109.  
  110.    IF ch = "e" THEN
  111.       INC (i);
  112.       x := e;
  113.       RETURN
  114.    ELSIF (ch = "p") & (s [i+1] = "i") THEN
  115.       x := pi;
  116.       i := i + 2;
  117.       RETURN;
  118.    END;
  119.  
  120.    WHILE (ch # 0C) & (ch # "+") & (ch # "-") & 
  121.          (ch # "*") & (ch # "/") & (ch # ")") DO
  122.       RealString [j] := ch;
  123.       INC (i);
  124.       INC (j);
  125.       ch := s [i]; 
  126.    END;
  127.    RealString [j] := 0C;
  128.    ConvertRealFromString (x, RealString, ok);
  129. END EvalReal;
  130.       
  131. (* ======================= EvalFunc =========================== *)
  132.  
  133. PROCEDURE EvalFunc (VAR s: ARRAY OF CHAR; VAR f: ARRAY OF CHAR; 
  134.                     VAR i: CARDINAL; VAR x: REAL; VAR ok: BOOLEAN);
  135.  
  136. (* This procedure evaluates the a mathematical function.  I have designed
  137.    EvalFunc so that you can easily add your own functions.  By looking at
  138.    the code you will see that you can call your new functions whatever you
  139.    want.  I don't recommend changing the ones that CALC already knows. *)
  140.  
  141. BEGIN
  142.    simple (s, i, x, ok);
  143.  
  144.    IF ok THEN
  145.       IF StrCmp ("sin", f) THEN
  146.          x := sin (x)
  147.       ELSIF StrCmp ("cos", f) THEN
  148.          x := cos (x)
  149.       ELSIF StrCmp ("tan", f) THEN
  150.          x := tan (x)
  151.       ELSIF StrCmp ("atn", f) THEN
  152.          x := arctan (x)
  153.       ELSIF StrCmp ("exp", f) THEN
  154.          x := exp (x)
  155.       ELSIF StrCmp ("ln", f) THEN
  156.          x := ln (x)
  157.       ELSIF StrCmp ("log", f) THEN
  158.          x := log (x)
  159.       ELSIF StrCmp ("sqrt", f) THEN
  160.          x := sqrt (x)
  161.       ELSIF StrCmp ("rad", f) THEN
  162.          x := RadToDeg (x)
  163.       ELSIF StrCmp ("deg", f) THEN
  164.          x := DegToRad (x)
  165.       ELSE
  166.          WriteString (f);
  167.          WriteString (" is an unimplemented function. ");
  168.          WriteString ("Result is incorrect.");
  169.          WriteLn;
  170.       END;
  171.    END;
  172.    
  173.    IF s [i] <> ")" THEN
  174.       ok := FALSE;
  175.    END;
  176.  
  177.    INC (i);
  178. END EvalFunc;
  179.       
  180. (* ========================= simple ============================ *)
  181.  
  182. PROCEDURE simple (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
  183.                   VAR ok: BOOLEAN);
  184.  
  185. VAR
  186.    sign, ch: CHAR;
  187.    y: REAL;
  188.  
  189. BEGIN
  190.    sign := '+';
  191.    IF (s [i] = '+') OR (s [i] = '-') THEN
  192.       sign := s [i];
  193.       INC (i);
  194.    END;
  195.    
  196.    term (s, i, x, ok);
  197.  
  198.    IF (sign = '-') THEN
  199.       x := -x;
  200.    END;
  201.  
  202.    ch := s [i];
  203.  
  204.    WHILE ok & ((ch = '+') OR (ch = '-')) DO
  205.       INC (i);
  206.       term (s, i, y, ok);
  207.       
  208.       IF ok THEN
  209.          IF ch = '+' THEN
  210.             x := x + y
  211.          ELSE
  212.             x := x - y;
  213.          END;
  214.       END;
  215.       ch := s[i];
  216.    END;
  217. END simple;
  218.  
  219. (* ========================== term =========================== *)
  220.  
  221. PROCEDURE term (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
  222.                 VAR ok: BOOLEAN);
  223.  
  224. VAR
  225.    y: REAL;
  226.    ch: CHAR;
  227.  
  228. BEGIN
  229.    factor (s, i, x, ok);
  230.    ch := s [i];
  231.  
  232.    WHILE ok & ((ch = '*') OR (ch = '/')) DO
  233.       INC (i);
  234.       factor (s, i, y, ok);
  235.  
  236.       IF ok THEN
  237.          IF ch = '*' THEN
  238.             x := x * y
  239.          ELSE
  240.             x := x / y;
  241.          END;
  242.       END;
  243.       ch := s[i];
  244.    END;
  245. END term;
  246.  
  247. (* ============================ factor =========================== *)
  248.  
  249. PROCEDURE factor (VAR s: ARRAY OF CHAR; VAR i: CARDINAL; VAR x: REAL;
  250.                   VAR ok: BOOLEAN);
  251.  
  252. VAR f: StringType;
  253.  
  254. BEGIN
  255.    IF s [i] = '(' THEN
  256.       INC (i);
  257.       simple (s, i, x, ok);
  258.  
  259.       IF ok THEN
  260.          IF s [i] # ')' THEN
  261.             ok := FALSE
  262.          ELSE
  263.             INC (i);
  264.          END;
  265.       END
  266.    ELSIF IsFunc (s, f, i) THEN
  267.       INC (i);
  268.       EvalFunc (s, f, i, x, ok)
  269.    ELSE
  270.       EvalReal (s, i, x, ok)
  271.    END;
  272. END factor;
  273.  
  274. (* ============================ MAIN PROGRAM ========================== *)
  275.  
  276. BEGIN          
  277.    i := 0;
  278.    NoError := TRUE;
  279.    result := 0.0;
  280.  
  281.    IF NOT GetCL (num, ArgArray) THEN
  282.       WriteString ("Error getting command line");
  283.       WriteLn
  284.    ELSE
  285.       IF (num = 0) THEN
  286.          WriteString ("CALC version 2.0 - written by Bob Jones");
  287.          WriteLn;
  288.          WriteString ("USAGE: calc [expression]");
  289.          WriteLn
  290.       ELSE
  291.          IF num > 1 THEN
  292.             FOR j := 1 TO num DO
  293.                Concat (Equation, ArgArray [j-1], dummy);
  294.                Assign (Equation, dummy);
  295.             END
  296.          ELSE
  297.             Assign (Equation, ArgArray [0]);
  298.          END;
  299.  
  300.          simple (Equation, i, result, NoError);
  301.  
  302.          IF Equation [i] # 0C THEN
  303.             NoError := FALSE;
  304.          END;
  305.  
  306.          IF NoError THEN
  307.             ConvertReal (result, 15, 6, StringAns);
  308.             WriteString (StringAns);
  309.             WriteLn
  310.          ELSE
  311.             WriteString ("Malformed expression: ");
  312.             WriteString (Equation);
  313.             WriteLn;
  314.          END;
  315.       END;
  316.    END;
  317. END calc.
  318.